home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Tools / Turbo Pascal V7 / TVDEMOS.ZIP / HELPFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-03  |  21KB  |  919 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision Demo                            }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit HelpFile;
  9.  
  10. {$F+,O+,X+,S-,R-}
  11.  
  12. interface
  13.  
  14. uses Objects, Drivers, Views;
  15.  
  16. const
  17.   CHelpColor      = #$37#$3F#$3A#$13#$13#$30#$3E#$1E;
  18.   CHelpBlackWhite = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  19.   CHelpMonochrome = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  20.   CHelpViewer     = #6#7#8;
  21.   CHelpWindow     = #128#129#130#131#132#133#134#135;
  22.  
  23. type
  24.  
  25. { TParagraph }
  26.  
  27.   PParagraph = ^TParagraph;
  28.   TParagraph = record
  29.     Next: PParagraph;
  30.     Wrap: Boolean;
  31.     Size: Word;
  32.     Text: record end;
  33.   end;
  34.  
  35. { THelpTopic }
  36.  
  37.   TCrossRef = record
  38.     Ref: Word;
  39.     Offset: Integer;
  40.     Length: Byte;
  41.   end;
  42.  
  43.   PCrossRefs = ^TCrossRefs;
  44.   TCrossRefs = array[1..10000] of TCrossRef;
  45.   TCrossRefHandler = procedure (var S: TStream; XRefValue: Integer);
  46.  
  47.   PHelpTopic = ^THelpTopic;
  48.   THelpTopic = object(TObject)
  49.     constructor Init;
  50.     constructor Load(var S: TStream);
  51.     destructor Done; virtual;
  52.     procedure AddCrossRef(Ref: TCrossRef);
  53.     procedure AddParagraph(P: PParagraph);
  54.     procedure GetCrossRef(I: Integer; var Loc: TPoint; var Length: Byte;
  55.       var Ref: Word);
  56.     function GetLine(Line: Integer): String;
  57.     function GetNumCrossRefs: Integer;
  58.     function NumLines: Integer;
  59.     procedure SetCrossRef(I: Integer; var Ref: TCrossRef);
  60.     procedure SetNumCrossRefs(I: Integer);
  61.     procedure SetWidth(AWidth: Integer);
  62.     procedure Store(var S: TStream);
  63.   private
  64.     Paragraphs: PParagraph;
  65.     NumRefs: Integer;
  66.     CrossRefs: PCrossRefs;
  67.     Width: Integer;
  68.     LastOffset: Integer;
  69.     LastLine: Integer;
  70.     LastParagraph: PParagraph;
  71.     function WrapText(var Text; Size: Integer; var Offset: Integer;
  72.       Wrap: Boolean): String;
  73.   end;
  74.  
  75. { THelpIndex }
  76.  
  77.   PIndexArray = ^TIndexArray;
  78.   TIndexArray = array[0..16380] of LongInt;
  79.  
  80.   PContextArray = ^TContextArray;
  81.   TContextArray = array[0..16380] of Word;
  82.  
  83.   PHelpIndex = ^THelpIndex;
  84.   THelpIndex = object(TObject)
  85.     constructor Init;
  86.     constructor Load(var S: TStream);
  87.     destructor Done; virtual;
  88.     function Position(I: Word): Longint;
  89.     procedure Add(I: Word; Val: Longint);
  90.     procedure Store(var S: TStream);
  91.   private
  92.     Size: Word;
  93.     Used: Word;
  94.     Contexts: PContextArray;
  95.     Index: PIndexArray;
  96.     function Find(I: Word): Word;
  97.   end;
  98.  
  99. { THelpFile }
  100.  
  101.   PHelpFile = ^THelpFile;
  102.   THelpFile = object(TObject)
  103.     Stream: PStream;
  104.     Modified: Boolean;
  105.     constructor Init(S: PStream);
  106.     destructor Done; virtual;
  107.     function GetTopic(I: Word): PHelpTopic;
  108.     function InvalidTopic: PHelpTopic;
  109.     procedure RecordPositionInIndex(I: Integer);
  110.     procedure PutTopic(Topic: PHelpTopic);
  111.   private
  112.     Index: PHelpIndex;
  113.     IndexPos: LongInt;
  114.   end;
  115.  
  116. { THelpViewer }
  117.  
  118.   PHelpViewer = ^THelpViewer;
  119.   THelpViewer = object(TScroller)
  120.     HFile: PHelpFile;
  121.     Topic: PHelpTopic;
  122.     Selected: Integer;
  123.     constructor Init(var Bounds: TRect; AHScrollBar,
  124.       AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  125.     destructor Done; virtual;
  126.     procedure ChangeBounds(var Bounds: TRect); virtual;
  127.     procedure Draw; virtual;
  128.     function GetPalette: PPalette; virtual;
  129.     procedure HandleEvent(var Event: TEvent); virtual;
  130.   end;
  131.  
  132. { THelpWindow }
  133.  
  134.   PHelpWindow = ^THelpWindow;
  135.   THelpWindow = object(TWindow)
  136.     constructor Init(HFile: PHelpFile; Context: Word);
  137.     function GetPalette: PPalette; virtual;
  138.   end;
  139.  
  140. const
  141.   RHelpTopic: TStreamRec = (
  142.      ObjType: 10000;
  143.      VmtLink: Ofs(TypeOf(THelpTopic)^);
  144.      Load:    @THelpTopic.Load;
  145.      Store:   @THelpTopic.Store
  146.   );
  147.  
  148. const
  149.   RHelpIndex: TStreamRec = (
  150.      ObjType: 10001;
  151.      VmtLink: Ofs(TypeOf(THelpIndex)^);
  152.      Load:    @THelpIndex.Load;
  153.      Store:   @THelpIndex.Store
  154.   );
  155.  
  156. procedure RegisterHelpFile;
  157.  
  158. procedure NotAssigned(var S: TStream; Value: Integer);
  159.  
  160. const
  161.   CrossRefHandler: TCrossRefHandler = NotAssigned;
  162.  
  163. implementation
  164.  
  165. { THelpTopic }
  166.  
  167. constructor THelpTopic.Init;
  168. begin
  169.   inherited Init;
  170.   LastLine := MaxInt;
  171. end;
  172.  
  173. constructor THelpTopic.Load(var S: TStream);
  174.  
  175. procedure ReadParagraphs;
  176. var
  177.   I, Size: Integer;
  178.   PP: ^PParagraph;
  179. begin
  180.   S.Read(I, SizeOf(I));
  181.   PP := @Paragraphs;
  182.   while I > 0 do
  183.   begin
  184.     S.Read(Size, SizeOf(Size));
  185.     GetMem(PP^, SizeOf(PP^^) + Size);
  186.     PP^^.Size := Size;
  187.     S.Read(PP^^.Wrap, SizeOf(Boolean));
  188.     S.Read(PP^^.Text, Size);
  189.     PP := @PP^^.Next;
  190.     Dec(I);
  191.   end;
  192.   PP^ := nil;
  193. end;
  194.  
  195. procedure ReadCrossRefs;
  196. begin
  197.   S.Read(NumRefs, SizeOf(Integer));
  198.   GetMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  199.   if CrossRefs <> nil then
  200.     S.Read(CrossRefs^, SizeOf(TCrossRef) * NumRefs);
  201. end;
  202.  
  203. begin
  204.   ReadParagraphs;
  205.   ReadCrossRefs;
  206.   Width := 0;
  207.   LastLine := MaxInt;
  208. end;
  209.  
  210. destructor THelpTopic.Done;
  211.  
  212. procedure DisposeParagraphs;
  213. var
  214.   P, T: PParagraph;
  215. begin
  216.   P := Paragraphs;
  217.   while P <> nil do
  218.   begin
  219.     T := P;
  220.     P := P^.Next;
  221.     FreeMem(T, SizeOf(T^) + T^.Size);
  222.   end;
  223. end;
  224.  
  225. begin
  226.   DisposeParagraphs;
  227.   FreeMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  228.   inherited Done
  229. end;
  230.  
  231. procedure THelpTopic.AddCrossRef(Ref: TCrossRef);
  232. var
  233.   P: PCrossRefs;
  234. begin
  235.   GetMem(P, (NumRefs+1) * SizeOf(TCrossRef));
  236.   if NumRefs > 0 then
  237.   begin
  238.     Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef));
  239.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  240.   end;
  241.   CrossRefs := P;
  242.   CrossRefs^[NumRefs] := Ref;
  243.   Inc(NumRefs);
  244. end;
  245.  
  246. procedure THelpTopic.AddParagraph(P: PParagraph);
  247. var
  248.   PP: ^PParagraph;
  249. begin
  250.   PP := @Paragraphs;
  251.   while PP^ <> nil do
  252.     PP := @PP^^.Next;
  253.   PP^ := P;
  254.   P^.Next := nil;
  255. end;
  256.  
  257. procedure THelpTopic.GetCrossRef(I: Integer; var Loc: TPoint;
  258.   var Length: Byte; var Ref: Word);
  259. var
  260.   OldOffset, CurOffset, Offset, ParaOffset: Integer;
  261.   P: PParagraph;
  262.   Line: Integer;
  263. begin
  264.   ParaOffset := 0;
  265.   CurOffset := 0;
  266.   OldOffset := 0;
  267.   Line := 0;
  268.   Offset := CrossRefs^[I].Offset;
  269.   P := Paragraphs;
  270.   while ParaOffset+CurOffset < Offset do
  271.   begin
  272.     OldOffset := ParaOffset + CurOffset;
  273.     WrapText(P^.Text, P^.Size, CurOffset, P^.Wrap);
  274.     Inc(Line);
  275.     if CurOffset >= P^.Size then
  276.     begin
  277.       Inc(ParaOffset, P^.Size);
  278.       P := P^.Next;
  279.       CurOffset := 0;
  280.     end;
  281.   end;
  282.   Loc.X := Offset - OldOffset - 1;
  283.   Loc.Y := Line;
  284.   Length := CrossRefs^[I].Length;
  285.   Ref := CrossRefs^[I].Ref;
  286. end;
  287.  
  288. function THelpTopic.GetLine(Line: Integer): String;
  289. var
  290.   Offset, I: Integer;
  291.   P: PParagraph;
  292. begin
  293.   if LastLine < Line then
  294.   begin
  295.     I := Line;
  296.     Dec(Line, LastLine);
  297.     LastLine := I;
  298.     Offset := LastOffset;
  299.     P := LastParagraph;
  300.   end
  301.   else
  302.   begin
  303.     P := Paragraphs;
  304.     Offset := 0;
  305.     LastLine := Line;
  306.   end;
  307.   GetLine := '';
  308.   while (P <> nil) do
  309.   begin
  310.     while Offset < P^.Size do
  311.     begin
  312.       Dec(Line);
  313.       GetLine := WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  314.       if Line = 0 then
  315.       begin
  316.         LastOffset := Offset;
  317.         LastParagraph := P;
  318.         Exit;
  319.       end;
  320.     end;
  321.     P := P^.Next;
  322.     Offset := 0;
  323.   end;
  324.   GetLine := '';
  325. end;
  326.  
  327. function THelpTopic.GetNumCrossRefs: Integer;
  328. begin
  329.   GetNumCrossRefs := NumRefs;
  330. end;
  331.  
  332. function THelpTopic.NumLines: Integer;
  333. var
  334.   Offset, Lines: Integer;
  335.   P: PParagraph;
  336. begin
  337.   Offset := 0;
  338.   Lines := 0;
  339.   P := Paragraphs;
  340.   while P <> nil do
  341.   begin
  342.     Offset := 0;
  343.     while Offset < P^.Size do
  344.     begin
  345.       Inc(Lines);
  346.       WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  347.     end;
  348.     P := P^.Next;
  349.   end;
  350.   NumLines := Lines;
  351. end;
  352.  
  353. procedure THelpTopic.SetCrossRef(I: Integer; var Ref: TCrossRef);
  354. begin
  355.   if I <= NumRefs then CrossRefs^[I] := Ref;
  356. end;
  357.  
  358. procedure THelpTopic.SetNumCrossRefs(I: Integer);
  359. var
  360.   P: PCrossRefs;
  361. begin
  362.   if NumRefs = I then Exit;
  363.   GetMem(P, I * SizeOf(TCrossRef));
  364.   if NumRefs > 0 then
  365.   begin
  366.     if I > NumRefs then Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef))
  367.     else Move(CrossRefs^, P^, I * SizeOf(TCrossRef));
  368.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  369.   end;
  370.   CrossRefs := P;
  371.   NumRefs := I;
  372. end;
  373.  
  374. procedure THelpTopic.SetWidth(AWidth: Integer);
  375. begin
  376.   Width := AWidth;
  377. end;
  378.  
  379. procedure THelpTopic.Store(var S: TStream);
  380.  
  381. procedure WriteParagraphs;
  382. var
  383.   I: Integer;
  384.   P: PParagraph;
  385. begin
  386.   P := Paragraphs;
  387.   I := 0;
  388.   while P <> nil do
  389.   begin
  390.     Inc(I);
  391.     P := P^.Next;
  392.   end;
  393.   S.Write(I, SizeOf(I));
  394.   P := Paragraphs;
  395.   while P <> nil do
  396.   begin
  397.     S.Write(P^.Size, SizeOf(Integer));
  398.     S.Write(P^.Wrap, SizeOf(Boolean));
  399.     S.Write(P^.Text, P^.Size);
  400.     P := P^.Next;
  401.   end;
  402. end;
  403.  
  404. procedure WriteCrossRefs;
  405. var
  406.   I: Integer;
  407. begin
  408.   S.Write(NumRefs, SizeOf(Integer));
  409.   if @CrossRefHandler = @NotAssigned then
  410.     S.Write(CrossRefs^, SizeOf(TCrossRef) * NumRefs)
  411.   else
  412.     for I := 1 to NumRefs do
  413.     begin
  414.       CrossRefHandler(S, CrossRefs^[I].Ref);
  415.       S.Write(CrossRefs^[I].Offset, SizeOf(Integer) + SizeOf(Byte));
  416.     end;
  417. end;
  418.  
  419. begin
  420.   WriteParagraphs;
  421.   WriteCrossRefs;
  422. end;
  423.  
  424. function THelpTopic.WrapText(var Text; Size: Integer;
  425.   var Offset: Integer; Wrap: Boolean): String;
  426. type
  427.   PCArray = ^CArray;
  428.   CArray = array[0..32767] of Char;
  429. var
  430.   Line: String;
  431.   I, P: Integer;
  432.  
  433. function IsBlank(Ch: Char): Boolean;
  434. begin
  435.   IsBlank := (Ch = ' ') or (Ch = #13) or (Ch = #10);
  436. end;
  437.  
  438. function Scan(var P; Offset, Size: Integer; C: Char): Integer; assembler;
  439. asm
  440.     CLD
  441.     LES    DI,P
  442.         ADD    DI,&Offset
  443.         MOV    DX,Size
  444.         SUB    DX,&Offset
  445.         OR    DH,DH
  446.         JZ    @@1
  447.         MOV    DX,256
  448. @@1:    MOV    CX,DX
  449.     MOV    AL, C
  450.         REPNE    SCASB
  451.     SUB    CX,DX
  452.         NEG    CX
  453.         XCHG    AX,CX
  454. end;
  455.  
  456. procedure TextToLine(var Text; Offset, Length: Integer; var Line: String);
  457.   assembler;
  458. asm
  459.     CLD
  460.     PUSH    DS
  461.     LDS    SI,Text
  462.         ADD    SI,&Offset
  463.         LES     DI,Line
  464.         MOV    AX,Length
  465.         STOSB
  466.         XCHG    AX,CX
  467.         REP    MOVSB
  468.         POP    DS
  469. end;
  470.  
  471. begin
  472.   I := Scan(Text, Offset, Size, #13);
  473.   if (I >= Width) and Wrap then
  474.   begin
  475.     I := Offset + Width;
  476.     if I > Size then I := Size
  477.     else
  478.     begin
  479.       while (I > Offset) and not IsBlank(PCArray(@Text)^[I]) do Dec(I);
  480.       if I = Offset then I := Offset + Width
  481.       else Inc(I);
  482.     end;
  483.     if I = Offset then I := Offset + Width;
  484.     Dec(I, Offset);
  485.   end;
  486.   TextToLine(Text, Offset, I, Line);
  487.   if Line[Length(Line)] = #13 then Dec(Line[0]);
  488.   Inc(Offset, I);
  489.   WrapText := Line;
  490. end;
  491.  
  492. { THelpIndex }
  493.  
  494. constructor THelpIndex.Init;
  495. begin
  496.   inherited Init;
  497.   Size := 0;
  498.   Contexts := nil;
  499.   Index := nil;
  500. end;
  501.  
  502. constructor THelpIndex.Load(var S: TStream);
  503. begin
  504.   S.Read(Used, SizeOf(Used));
  505.   S.Read(Size, SizeOf(Size));
  506.   if Size = 0 then
  507.   begin
  508.     Contexts := nil;
  509.     Index := nil;
  510.   end
  511.   else
  512.   begin
  513.     GetMem(Contexts, SizeOf(Contexts^[0]) * Size);
  514.     S.Read(Contexts^, SizeOf(Contexts^[0]) * Size);
  515.     GetMem(Index, SizeOf(Index^[0]) * Size);
  516.     S.Read(Index^, SizeOf(Index^[0]) * Size);
  517.   end;
  518. end;
  519.  
  520. destructor THelpIndex.Done;
  521. begin
  522.   FreeMem(Index, SizeOf(Index^[0]) * Size);
  523.   FreeMem(Contexts, SizeOf(Contexts^[0]) * Size);
  524.   inherited Done;
  525. end;
  526.  
  527. function THelpIndex.Find(I: Word): Word;
  528. var
  529.   Hi, Lo, Pos: Integer;
  530. begin
  531.   Lo := 0;
  532.   if Used > 0 then
  533.   begin
  534.     Hi := Used - 1;
  535.     while Lo <= Hi do
  536.     begin
  537.       Pos := (Lo + Hi) div 2;
  538.       if I > Contexts^[Pos] then
  539.         Lo := Pos + 1
  540.       else
  541.       begin
  542.         Hi := Pos - 1;
  543.         if I = Contexts^[Pos] then
  544.           Lo := Pos;
  545.       end;
  546.     end;
  547.   end;
  548.   Find := Lo;
  549. end;
  550.  
  551. function THelpIndex.Position(I: Word): Longint;
  552. begin
  553.   Position := Index^[Find(I)];
  554. end;
  555.  
  556. procedure THelpIndex.Add(I: Word; Val: Longint);
  557. const
  558.   Delta = 10;
  559. var
  560.   P: PIndexArray;
  561.   NewSize: Integer;
  562.   Pos: Integer;
  563.  
  564.   function Grow(P: Pointer; OldSize, NewSize, ElemSize: Integer): Pointer;
  565.   var
  566.     NewP: PByteArray;
  567.   begin
  568.     GetMem(NewP, NewSize * ElemSize);
  569.     if NewP <> nil then
  570.     begin
  571.       if P <> nil then
  572.         Move(P^, NewP^, OldSize * ElemSize);
  573.       FillChar(NewP^[OldSize * ElemSize], (NewSize - Size) * ElemSize, $FF);
  574.     end;
  575.     if OldSize > 0 then FreeMem(P, OldSize * ElemSize);
  576.     Grow := NewP;
  577.   end;
  578.  
  579. begin
  580.   Pos := Find(I);
  581.   if (Contexts = nil) or (Contexts^[Pos] <> I) then
  582.   begin
  583.     Inc(Used);
  584.     if Used >= Size then
  585.     begin
  586.       NewSize := (Used + Delta) div Delta * Delta;
  587.       Contexts := Grow(Contexts, Size, NewSize, SizeOf(Contexts^[0]));
  588.       Index := Grow(Index, Size, NewSize, SizeOf(Index^[0]));
  589.       Size := NewSize;
  590.     end;
  591.     if Pos < Used then
  592.     begin
  593.       Move(Contexts^[Pos], Contexts^[Pos + 1], (Used - Pos - 1) *
  594.         SizeOf(Contexts^[0]));
  595.       Move(Index^[Pos], Index^[Pos + 1], (Used - Pos - 1) *
  596.         SizeOf(Index^[0]));
  597.     end;
  598.   end;
  599.   Contexts^[Pos] := I;
  600.   Index^[Pos] := Val;
  601. end;
  602.  
  603. procedure THelpIndex.Store(var S: TStream);
  604. begin
  605.   S.Write(Used, SizeOf(Used));
  606.   S.Write(Size, SizeOf(Size));
  607.   S.Write(Contexts^, SizeOf(Contexts^[0]) * Size);
  608.   S.Write(Index^, SizeOf(Index^[0]) * Size);
  609. end;
  610.  
  611. { THelpFile }
  612.  
  613. const
  614.   MagicHeader = $46484246; {'FBHF'}
  615.  
  616. constructor THelpFile.Init(S: PStream);
  617. var
  618.   Magic: Longint;
  619. begin
  620.   Magic := 0;
  621.   S^.Seek(0);
  622.   if S^.GetSize > SizeOf(Magic) then
  623.     S^.Read(Magic, SizeOf(Magic));
  624.   if Magic <> MagicHeader then
  625.   begin
  626.     IndexPos := 12;
  627.     S^.Seek(IndexPos);
  628.     Index := New(PHelpIndex, Init);
  629.     Modified := True;
  630.   end
  631.   else
  632.   begin
  633.     S^.Seek(8);
  634.     S^.Read(IndexPos, SizeOf(IndexPos));
  635.     S^.Seek(IndexPos);
  636.     Index := PHelpIndex(S^.Get);
  637.     Modified := False;
  638.   end;
  639.   Stream := S;
  640. end;
  641.  
  642. destructor THelpFile.Done;
  643. var
  644.   Magic, Size: Longint;
  645. begin
  646.   if Modified then
  647.   begin
  648.     Stream^.Seek(IndexPos);
  649.     Stream^.Put(Index);
  650.     Stream^.Seek(0);
  651.     Magic := MagicHeader;
  652.     Size := Stream^.GetSize - 8;
  653.     Stream^.Write(Magic, SizeOf(Magic));
  654.     Stream^.Write(Size, SizeOf(Size));
  655.     Stream^.Write(IndexPos, SizeOf(IndexPos));
  656.   end;
  657.   Dispose(Stream, Done);
  658.   Dispose(Index, Done);
  659. end;
  660.  
  661. function THelpFile.GetTopic(I: Word): PHelpTopic;
  662. var
  663.   Pos: Longint;
  664. begin
  665.   Pos := Index^.Position(I);
  666.   if Pos > 0 then
  667.   begin
  668.     Stream^.Seek(Pos);
  669.     GetTopic := PHelpTopic(Stream^.Get);
  670.   end
  671.   else GetTopic := InvalidTopic;
  672. end;
  673.  
  674. function THelpFile.InvalidTopic: PHelpTopic;
  675. var
  676.   Topic: PHelpTopic;
  677.   Para: PParagraph;
  678. const
  679.   InvalidStr = #13' No help available in this context.';
  680.   InvalidText: array[1..Length(InvalidStr)] of Char = InvalidStr;
  681. begin
  682.   Topic := New(PHelpTopic, Init);
  683.   GetMem(Para, SizeOf(Para^) + SizeOf(InvalidText));
  684.   Para^.Size := SizeOf(InvalidText);
  685.   Para^.Wrap := False;
  686.   Para^.Next := nil;
  687.   Move(InvalidText, Para^.Text, SizeOf(InvalidText));
  688.   Topic^.AddParagraph(Para);
  689.   InvalidTopic := Topic;
  690. end;
  691.  
  692. procedure THelpFile.RecordPositionInIndex(I: Integer);
  693. begin
  694.   Index^.Add(I, IndexPos);
  695.   Modified := True;
  696. end;
  697.  
  698. procedure THelpFile.PutTopic(Topic: PHelpTopic);
  699. begin
  700.   Stream^.Seek(IndexPos);
  701.   Stream^.Put(Topic);
  702.   IndexPos := Stream^.GetPos;
  703.   Modified := True;
  704. end;
  705.  
  706. { THelpViewer }
  707.  
  708. constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar,
  709.   AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  710. begin
  711.   inherited Init(Bounds, AHScrollBar, AVScrollBar);
  712.   Options := Options or ofSelectable;
  713.   GrowMode := gfGrowHiX + gfGrowHiY;
  714.   HFile := AHelpFile;
  715.   Topic := AHelpFile^.GetTopic(Context);
  716.   Topic^.SetWidth(Size.X);
  717.   SetLimit(78, Topic^.NumLines);
  718.   Selected := 1;
  719. end;
  720.  
  721. destructor THelpViewer.Done;
  722. begin
  723.   inherited Done;
  724.   Dispose(HFile, Done);
  725.   Dispose(Topic, Done);
  726. end;
  727.  
  728. procedure THelpViewer.ChangeBounds(var Bounds: TRect);
  729. begin
  730.   inherited ChangeBounds(Bounds);
  731.   Topic^.SetWidth(Size.X);
  732.   SetLimit(Limit.X, Topic^.NumLines);
  733. end;
  734.  
  735. procedure THelpViewer.Draw;
  736. var
  737.   B: TDrawBuffer;
  738.   Line: String;
  739.   I, J, L: Integer;
  740.   KeyCount: Integer;
  741.   Normal, Keyword, SelKeyword, C: Byte;
  742.   KeyPoint: TPoint;
  743.   KeyLength: Byte;
  744.   KeyRef: Word;
  745. begin
  746.   Normal := GetColor(1);
  747.   Keyword := GetColor(2);
  748.   SelKeyword := GetColor(3);
  749.   KeyCount := 0;
  750.   KeyPoint.X := 0;
  751.   KeyPoint.Y := 0;
  752.   Topic^.SetWidth(Size.X);
  753.   if Topic^.GetNumCrossRefs > 0 then
  754.     repeat
  755.       Inc(KeyCount);
  756.       Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  757.     until (KeyCount >= Topic^.GetNumCrossRefs) or (KeyPoint.Y > Delta.Y);
  758.   for I := 1 to Size.Y do
  759.   begin
  760.     MoveChar(B, ' ', Normal, Size.X);
  761.     Line := Topic^.GetLine(I + Delta.Y);
  762.     MoveStr(B, Copy(Line, Delta.X+1, Size.X), Normal);
  763.     while I + Delta.Y = KeyPoint.Y do
  764.     begin
  765.       L := KeyLength;
  766.       if KeyPoint.X < Delta.X then
  767.       begin
  768.         Dec(L, Delta.X - KeyPoint.X);
  769.         KeyPoint.X := Delta.X;
  770.       end;
  771.       if KeyCount = Selected then C := SelKeyword
  772.       else C := Keyword;
  773.       for J := 0 to L-1 do
  774.         WordRec(B[KeyPoint.X - Delta.X + J]).Hi := C;
  775.       Inc(KeyCount);
  776.       if KeyCount <= Topic^.GetNumCrossRefs then
  777.         Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef)
  778.       else KeyPoint.Y := 0;
  779.     end;
  780.     WriteLine(0, I-1, Size.X, 1, B);
  781.   end;
  782. end;
  783.  
  784. function THelpViewer.GetPalette: PPalette;
  785. const
  786.   P: String[Length(CHelpViewer)] = CHelpViewer;
  787. begin
  788.   GetPalette := @P;
  789. end;
  790.  
  791. procedure THelpViewer.HandleEvent(var Event: TEvent);
  792. var
  793.   KeyPoint, Mouse: TPoint;
  794.   KeyLength: Byte;
  795.   KeyRef: Word;
  796.   KeyCount: Integer;
  797.  
  798. procedure MakeSelectVisible;
  799. var
  800.   D: TPoint;
  801. begin
  802.   Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  803.   D := Delta;
  804.   if KeyPoint.X < D.X then D.X := KeyPoint.X
  805.   else if KeyPoint.X + KeyLength > D.X + Size.X then
  806.     D.X := KeyPoint.X + KeyLength - Size.X + 1;
  807.   if KeyPoint.Y <= D.Y then D.Y := KeyPoint.Y - 1;
  808.   if KeyPoint.Y > D.Y + Size.Y then D.Y := KeyPoint.Y - Size.Y;
  809.   if (D.X <> Delta.X) or (D.Y <> Delta.Y) then ScrollTo(D.X, D.Y);
  810. end;
  811.  
  812. procedure SwitchToTopic(KeyRef: Integer);
  813. begin
  814.   if Topic <> nil then Dispose(Topic, Done);
  815.   Topic := HFile^.GetTopic(KeyRef);
  816.   Topic^.SetWidth(Size.X);
  817.   ScrollTo(0, 0);
  818.   SetLimit(Limit.X, Topic^.NumLines);
  819.   Selected := 1;
  820.   DrawView;
  821. end;
  822.  
  823. begin
  824.   inherited HandleEvent(Event);
  825.   case Event.What of
  826.     evKeyDown:
  827.       begin
  828.         case Event.KeyCode of
  829.           kbTab:
  830.             if Topic^.GetNumCrossRefs > 0 then
  831.             begin
  832.               Inc(Selected);
  833.               if Selected > Topic^.GetNumCrossRefs then Selected := 1;
  834.               MakeSelectVisible;
  835.             end;
  836.           kbShiftTab:
  837.             if Topic^.GetNumCrossRefs > 0 then
  838.             begin
  839.               Dec(Selected);
  840.               if Selected = 0 then Selected := Topic^.GetNumCrossRefs;
  841.               MakeSelectVisible;
  842.             end;
  843.           kbEnter:
  844.             if Selected <= Topic^.GetNumCrossRefs then
  845.             begin
  846.               Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  847.               SwitchToTopic(KeyRef);
  848.             end;
  849.           kbEsc:
  850.             begin
  851.               Event.What := evCommand;
  852.               Event.Command := cmClose;
  853.               PutEvent(Event);
  854.             end;
  855.         else
  856.           Exit;
  857.         end;
  858.         DrawView;
  859.         ClearEvent(Event);
  860.       end;
  861.     evMouseDown:
  862.       begin
  863.         MakeLocal(Event.Where, Mouse);
  864.         Inc(Mouse.X, Delta.X); Inc(Mouse.Y, Delta.Y);
  865.         KeyCount := 0;
  866.         repeat
  867.           Inc(KeyCount);
  868.           if KeyCount > Topic^.GetNumCrossRefs then Exit;
  869.           Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  870.         until (KeyPoint.Y = Mouse.Y+1) and (Mouse.X >= KeyPoint.X) and
  871.           (Mouse.X < KeyPoint.X + KeyLength);
  872.         Selected := KeyCount;
  873.         DrawView;
  874.         if Event.Double then SwitchToTopic(KeyRef);
  875.         ClearEvent(Event);
  876.       end;
  877.     evCommand:
  878.       if (Event.Command = cmClose) and (Owner^.State and sfModal <> 0) then
  879.       begin
  880.         EndModal(cmClose);
  881.         ClearEvent(Event);
  882.       end;
  883.   end;
  884. end;
  885.  
  886. { THelpWindow }
  887.  
  888. constructor THelpWindow.Init(HFile: PHelpFile; Context: Word);
  889. var
  890.   R: TRect;
  891. begin
  892.   R.Assign(0, 0, 50, 18);
  893.   TWindow.Init(R, 'Help', wnNoNumber);
  894.   Options := Options or ofCentered;
  895.   R.Grow(-2,-1);
  896.   Insert(New(PHelpViewer, Init(R,
  897.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  898.     StandardScrollBar(sbVertical + sbHandleKeyboard), HFile, Context)));
  899. end;
  900.  
  901. function THelpWindow.GetPalette: PPalette;
  902. const
  903.   P: String[Length(CHelpWindow)] = CHelpWindow;
  904. begin
  905.   GetPalette := @P;
  906. end;
  907.  
  908. procedure RegisterHelpFile;
  909. begin
  910.   RegisterType(RHelpTopic);
  911.   RegisterType(RHelpIndex);
  912. end;
  913.  
  914. procedure NotAssigned(var S: TStream; Value: Integer);
  915. begin
  916. end;
  917.  
  918. end.
  919.